home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 9 / Night Owl CD-ROM (NOPV9) (Night Owl Publisher) (1993).ISO / 012a / lib194.zip / FINANCE.PRG < prev    next >
Text File  |  1993-02-05  |  46KB  |  1,096 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: FINANCE.PRG
  3. *-- Programmer: Ken Mayer (CIS: 71333,1030)
  4. *-- Date......: 02/05/1993
  5. *-- Notes.....: These finance functions are for use with interest rates and 
  6. *--             such. See the file README.TXT for details about the use of this
  7. *--             library file.
  8. *--
  9. *--             NOTES ABOUT THESE ROUTINES (the ones written by Jay Parsons)
  10. *--             The functions that use (1+nRate)^nPeriods require that the
  11. *--             rate be stated in the same terms as the compounding period.
  12. *--             That is, for monthly compounding the nRate should be the annual
  13. *--             rate / 12, and the nPeriods the number of months, and so forth.
  14. *--
  15. *--             If the situation involves continuous compounding, state the
  16. *--             rate as the exponent of the annual rate, less 1, and state the
  17. *--             periods in years.  Accordingly, to find the value in 30 months
  18. *--             of a $1000 investment continuously compounded at 6%, use:
  19. *--                 FuturVal(1000,exp(.06)-1,30/12)
  20. *--
  21. *--             These functions (except NPV(), which sums a series of equal
  22. *-              or unequal cash flows), are designed for use with a single
  23. *--             "investment", one payment or receipt.  If the problem involves
  24. *--             a series of equal payments or receipts like a mortgage loan,
  25. *--             a Holiday Club or an annuity, the fv() and pv() functions
  26. *--             built in to dBASE IV should be used instead where possible.
  27. *-------------------------------------------------------------------------------
  28.  
  29. FUNCTION Discount
  30. *-------------------------------------------------------------------------------
  31. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  32. *-- Date........: 03/01/1992
  33. *-- Notes.......: Compute the present value of an amount to be received at the
  34. *--               end of a number of periods given a periodic interest rate.
  35. *-- Written for.: dBASE IV, 1.1
  36. *-- Rev. History: None
  37. *-- Calls.......: None
  38. *-- Called by...: Any
  39. *-- Usage.......: Discount(<nFuturVal>,<nRate>,<nPeriods>)
  40. *-- Example.....: ?Discount(1000,.08,6)
  41. *-- Returns.....: Numeric
  42. *-- Parameters..: nFuturVal = the amount to be received/paid in the future
  43. *--               nRate     = the periodic rate of interest
  44. *--               nPeriods  = the number of periods
  45. *-------------------------------------------------------------------------------
  46.  
  47.     parameters nFuturVal, nRate, nPeriods
  48.     
  49. RETURN nFuturVal / ( 1 + nRate ) ^ nPeriods
  50. *-- EoF: Discount()
  51.  
  52. FUNCTION FuturVal
  53. *-------------------------------------------------------------------------------
  54. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  55. *-- Date........: 03/01/1992
  56. *-- Notes.......: Compute the future value of an initial amount at compound
  57. *--               interest received at a given periodic rate for a number of
  58. *--               periods.
  59. *-- Written for.: dBASE IV, 1.0
  60. *-- Rev. History: None
  61. *-- Calls.......: None
  62. *-- Called by...: Any
  63. *-- Usage.......: FuturVal(<nPresVal>,<nRate>,<nPeriods>)
  64. *-- Example.....: ?FuturVal(10000,.06,48)
  65. *-- Returns.....: Numeric
  66. *-- Parameters..: nPresVal = Present Value
  67. *--               nRate    = Periodic interest rate
  68. *--               nPeriods = Number of periods to calculate for
  69. *-------------------------------------------------------------------------------
  70.  
  71.     parameters nPresVal, nRate, nPeriods
  72.     
  73. RETURN nPresVal * ( 1 + nRate ) ^ nPeriods
  74. *-- EoF: FuturVal()
  75.  
  76. FUNCTION Rate
  77. *-------------------------------------------------------------------------------
  78. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  79. *-- Date........: 03/01/1992
  80. *-- Notes.......: Compute rate of periodic interest needed to produce a future
  81. *--               value from a present value in a given number of periods.  If
  82. *--               the periods are not years, you'll probably want to multiply
  83. *--               the rate returned by the number of periods in a year to 
  84. *--               obtain the equivalent annual rate.
  85. *-- Written for.: dBASE IV, 1.1
  86. *-- Rev. History: None
  87. *-- Calls.......: None
  88. *-- Called by...: Any
  89. *-- Usage.......: Rate(<nFutVal>,<nPresVal>,<nPeriods>)
  90. *-- Example.....: ?Rate(50000,10000,48)
  91. *-- Returns.....: Numeric
  92. *-- Parameters..: nFutVal  = Future Value
  93. *--               nPresVal = Present Value
  94. *--               nPeriods = Number of periods to calculate for
  95. *-------------------------------------------------------------------------------
  96.  
  97.     parameters nFutVal, nPresVal, nPeriods
  98.     
  99. RETURN ( nFutVal / nPresVal ) ^ ( 1 / nPeriods ) - 1
  100. *-- EoF: Rate()
  101.  
  102. FUNCTION ContRate
  103. *-------------------------------------------------------------------------------
  104. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  105. *-- Date........: 03/01/1992
  106. *-- Notes.......: Rate if compounding is continuous.  Periods must be years.
  107. *-- Written for.: dBASE IV, 1.1
  108. *-- Rev. History: None
  109. *-- Calls.......: RATE()               Function in FINANCE.PRG
  110. *-- Called by...: Any
  111. *-- Usage.......: ContRate(<nFutVal>,<nPresVal>,<nYears>)
  112. *-- Example.....: ?ContRate(50000,10000,4)
  113. *-- Returns.....: Numeric
  114. *-- Parameters..: nFutVal  = Future Value
  115. *--               nPresVal = Present Value
  116. *--               nYears   = Number of years to calculate for
  117. *-------------------------------------------------------------------------------
  118.  
  119.     parameters nFutVal, nPresVal, nYears
  120.     
  121. RETURN log( 1 + Rate( nFutval, nPresval, nYears ) )
  122. *-- EoF: ContRate()
  123.  
  124. FUNCTION NPV
  125. *-------------------------------------------------------------------------------
  126. *-- Programmer..: Tony Lima (CIS: 72331,3724) and Jay Parsons (CIS: 70160,340)
  127. *-- Date........: 03/01/1992
  128. *-- Notes.......: Net present value of array aCashflow[ nPeriods ]
  129. *--               Calculates npv given assumed rate and # periods.
  130. *--               See "Other inputs" below for instructions/details ...
  131. *-- Written for.: dBASE IV, 1.1
  132. *-- Rev. History: None
  133. *-- Calls.......: None
  134. *-- Called by...: Any
  135. *-- Usage.......: NPV(<nRate>,<nPeriods>)
  136. *-- Example.....: ? NPV( .06, 6 )
  137. *-- Returns.....: Float = value of the project at given rate
  138. *-- Parameters..: nRate    = Interest Rate
  139. *--             : nPeriods = Number of Periods to calculate for
  140. *-- Other inputs: Requires the array aCashflow[ ] set up before calling.
  141. *--             : Each of its elements [n] holds the cash flow at the
  142. *--             : beginning of period n, with a negative amount indicating
  143. *--             : a cash outflow.  Elements of value 0 must be included for
  144. *--             : all periods with no cash flow, and all periods must be of
  145. *--             : equal length.
  146. *--             :  If the project is expected to require an immediate outlay
  147. *--             : of $6,000 and to return $2,000 at the end of each of the
  148. *--             : first five years thereafter, the array will be:
  149. *--             :       aCashflow[1] = -6000
  150. *--             :       aCashflow[2] =  2000
  151. *--             :       aCashflow[3] =  2000
  152. *--             :           * * *
  153. *--             :       aCashflow[6] =  2000
  154. *--             :
  155. *--             :  If the cash flows are at the end of the periods, rather
  156. *--             : than at the beginning, assign 0 to aCashFlow[1], then
  157. *--             : assign cash flows successively. aCashFlow[2] will then
  158. *--             : represent the cash flow at the end of period 1, rather
  159. *--             : than at the beginning of period 2, which is the same thing.
  160. *--             :
  161. *--             :  Rewriting the function to have array name passed as a 
  162. *--             : parameter is possible, but will slow down execution to an 
  163. *--             : extent that will be very noticeable if this function is being
  164. *--             : repeatedly executed, as by Zeroin() to find an Internal Rate
  165. *--             : of Return.
  166. *-------------------------------------------------------------------------------
  167.  
  168.     parameters nRate, nPeriods
  169.     private nDiscount, nFactor, nPeriod, nNpv
  170.     nPeriod = 1
  171.     nNpv = aCashflow[ 1 ]
  172.     nDiscount = float( 1 )
  173.     nFactor = 1 / ( 1 + nRate )
  174.     do while nPeriod < nPeriods
  175.         nPeriod = nPeriod + 1
  176.         nDiscount = nDiscount * nFactor
  177.         nNpv = nNpv + aCashflow[ nPeriod ] * nDiscount
  178.     enddo
  179.     
  180. RETURN nNpv
  181. *-- EoF: NPV()
  182.  
  183. FUNCTION Irr
  184. *-------------------------------------------------------------------------------
  185. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  186. *--             : Based on code by Tony Lima (CIS: 72331,3724), 1990.
  187. *-- Date........: 4/13/1992
  188. *-- Notes.......: Finds internal rate of return using Zeroin().
  189. *--             : An internal rate of return is an interest rate at
  190. *--             : which the net present value of a series of cash flows
  191. *--             : is zero.  In the normal case of an investment, where
  192. *--             : cash flows out at first, then comes back in later periods,
  193. *--             : the IRR gives the interest rate for an equally-good deal, and
  194. *--             : investments with higher IRR should be considered first.
  195. *--             :
  196. *--             : As this function uses the Npv() function to evaluate the
  197. *--             : cash flows at each assumed rate, and Npv() requires for
  198. *--             : speed that the cash flows be placed in the array aCashflow[],
  199. *--             : the cash flows must be placed there before calling this
  200. *--             : function.  The number of rows in aCashflow[] is a parameter
  201. *--             : passed through by Zeroin() to Npv().
  202. *--             :
  203. *-- Written for.: dBASE IV Version 1.5
  204. *-- Rev. History: Original function 1990.
  205. *--             : Modified to match Zeroin(), Npv(), 4/13/1992
  206. *-- Calls       : Zeroin()          Function in STATS.PRG
  207. *--             : Arrayrows()       Function in ARRAYS.PRG
  208. *-- Called by...: Any
  209. *-- Usage.......: ? Irr( <fX1>, <fX2>, n_Flag )
  210. *-- Example.....: nRate = Irr( 11, 0, 200, n_Flag )
  211. *-- Returns     : a float value representing Irr, if n_Flag < 3.
  212. *-- Parameters..: fX1, lowest plausible rate of return from this project.
  213. *--             : fX2, highest plausible rate of return, ditto.
  214. *--             : n_Flag, an integer to signal success ( < 3 ) or failure.
  215. *-- Other input : Requires advance setup of array to be called by Npv,
  216. *--             : as furnished "aCashflow[]", to hold cash flows.
  217. *-- Side effects: Uses and alters a global numeric variable, here called
  218. *--             : "n_Flag", to report error conditions resulting in value
  219. *--             : returned being meaningless.
  220. *-------------------------------------------------------------------------------
  221.    PARAMETERS fX1, fX2, n_Flag
  222.  
  223. RETURN Zeroin( "Npv", fX1, fX2, float( 1 / 10 ^ 6 ), 100, ;
  224.          n_Flag, arrayrows( "aCashflow" ) )
  225. *-- EoF: Irr()
  226.  
  227. FUNCTION Irr2 && {version 1.01}
  228. *-------------------------------------------------------------------------------
  229. *-- Programmer...: Ron Allen (CIS: 71201,2502)
  230. *-- Date.........: 01/25/1993
  231. *-- Notes........: Returns internal rate of return on an investment from
  232. *--                evenly-spaced periodic cashflows. The UDF simultaneously
  233. *--                accumulates the periodic Net Present Values of the
  234. *--                individual cashflows along with the first derivative of
  235. *--                the function. After the summation is completed for each
  236. *--                guess, the guess is adjusted by subtracting the ratio
  237. *--                of the function to its derivative.
  238. *-- Written for..: dBASEIV, version 1.5, tested on build xx71
  239. *-- Rev. History.: 1.01  01/28/93 - to add missing private variables. To
  240. *--                count iterations without sign change in PV. Move
  241. *--                division by nRatio outside inner loop.
  242. *-- Calls........: None
  243. *-- Called by....: Any
  244. *-- Usage........: Irr2(<nN>, <cFlow>, <lSw>, <nGuess>)
  245. *-- Example......: Rate = Irr2(6, "Cash", Switch, .01)
  246. *-- Returns......: Internal Rate of Return.
  247. *-- Parameters...: nN     = number of cashflows in model
  248. *--                cFlow  = name of the array holding the cashflows
  249. *--                lSw    = name of a logical variable to be switched to
  250. *--                         indicate valid IRR returned (.t.).
  251. *--                nGuess = optional guess for initialing search.
  252. *-------------------------------------------------------------------------------
  253.    parameters nN, cFlow, lSw, nGuess
  254.    private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, nBigchange
  255.    private nSignChng, nDiscount, nRatio, nSumPV, nCurrPV, nSumDeriv, nOldPV
  256.    private nIters, lSw1
  257.    store 0 to nI, nPosVal, nNegVal, nIters
  258.    store .t. to lSw
  259.    store .f. to lSw1
  260.    declare nCashFlow[nN]
  261.  
  262.     *--  Transfer cashflows to a private array and separate negatives from
  263.     *--  positives
  264.    do while nI < nN
  265.        nI = nI+1
  266.        store &cFlow[nI] to nCashFlow[nI], nCurVal
  267.        if nCurVal < 0
  268.            nNegVal = nNegVal + nCurVal
  269.        else
  270.            nPosVal = nPosVal + nCurVal
  271.        endif
  272.    enddo
  273.    if nNegVal = 0 .or. nPosVal = 0
  274.        wait "Must have at least one positive and one negative value"
  275.    endif
  276.  
  277.     *-- Use initializing guess if provided, otherwise calculate from
  278.     *-- weighted average returns.
  279.         
  280.    if pcount() = 4
  281.       nIRR = nGuess
  282.    else
  283.        nIRR = ((-nPosVal/nNegVal)-1)/nN
  284.    endif
  285.     
  286.     *-- Housekeeping summary accumulators, etc., before entering loop
  287.    store 1 to nNuDelta, nOlDelta
  288.    store 0 to nSignChng, nBigChange
  289.  
  290.     *--  Loop until estimated rate indicated accuracy
  291.    do while abs(nNuDelta) > .000001
  292.        store 0 to nI, nSumPV, nSumDeriv
  293.     
  294.         *-- Set up cumulative denominator to calculate incremental NPV
  295.        nDiscount = 1
  296.        nRatio = 1 + nIRR
  297.        do while nI < nN
  298.            nI = nI+1
  299.            nDiscount = nDiscount/nRatio
  300.         
  301.             *-- Calculate incremental PV and add to sum
  302.            nCurrPV = nDiscount * nCashFlow[nI]
  303.            nSumPV = nSumPV + nCurrPV
  304.         
  305.             *-- Add incremental first derivative to derivative sum
  306.            nSumDeriv = nSumDeriv - nI * nCurrPV
  307.        enddo
  308.     
  309.         *-- count iterations and test for sign change of future value
  310.        if .not. lSw1 .and. nIters > 0
  311.            lSw1 = iif(sign(nOldPV) = sign(nSumPV),.f.,.t.)
  312.        endif
  313.        nIters = nIters + 1
  314.        nOldPV = nSumPV
  315.  
  316.  
  317.         *-- Calculate indicated change in IRR
  318.        nNuDelta = nRatio * nSumPV/nSumDeriv
  319.     
  320.         *-- Test for big changes in adjusted IRR, limit to 10 times
  321.         *-- current guess for IRR and count big changes.
  322.        if abs(nNuDelta/nIRR) > 10
  323.            nNuDelta = sign(nNuDelta) * 10 * nIRR
  324.            nBigChange = nBigChange + 1
  325.        endif
  326.        nIRR = nIRR - nNuDelta   && Make adjustment to guess for IRR
  327.     
  328.         *-- Count reversals in adjustments to limit hunting
  329.        nSignChng = nSignChng + iif(sign(nNuDelta) + sign(nOlDelta) = 0,1,0)
  330.        nOlDelta = nNuDelta
  331.     
  332.         *-- Test for hunting, too many bigchanges or too large a solution
  333.         *-- and set external switch if abnormal exit is used.
  334.        if nSignChng + nBigChange > 10 .or. abs(nIRR) > 100 .or. ;
  335.           (nIters > 9 .and. .not. lSw1)
  336.            store .f. to lSw
  337.            exit
  338.        endif
  339.    enddo
  340.  
  341. RETURN nIRR
  342. *-- EoF: Irr2()
  343.  
  344. FUNCTION Mirr  && {version 1.0}
  345. *-------------------------------------------------------------------------------
  346. *-- Programmer...: Ron Allen (CIS: 71201,2502)
  347. *-- Date.........: 01/27/1993
  348. *-- Notes........: Used to calculate the Modified Internal Rate of Return
  349. *--                for evenly-spaced periodic cashflows. The modifications
  350. *--                assume that more realistic investment models should 
  351. *--                account for the cost of borrowing or the lower 'safe'
  352. *--                rate for keeping reserve funds to cover outlays and the
  353. *--                fact that reinvestments will be made at some other rate 
  354. *--                than the IRR itself. This model calculates the answer
  355. *--                directly, therefore more rapidly than the iterative
  356. *--                approach used by IRR. 
  357. *-- Written for..: dBASEIV,  version 1.5, tested on build xx71
  358. *-- Rev. History.: None
  359. *-- Calls........: None
  360. *-- Called by....: Any
  361. *-- Usage........: Mirr(<nN>, <cFlow>, <nRrate>, <nFrate>)
  362. *-- Example......: Rate = Mirr(6, "Cash", .1, .14)
  363. *-- Returns......: Modified Internal Rate of Return per period.
  364. *-- Parameters...: nN     = number of cashflows in model
  365. *--                cFlow  = name of the array holding the cashflows
  366. *--                nRrate = Reinvestment rate for positive cashflows. 
  367. *--                nFrate = 'Safe' rate expected on reserve funds to 
  368. *--                          cover disbursements.
  369. *-------------------------------------------------------------------------------
  370.    parameters nN, cFlow, nRrate, nFrate
  371.    private nI, nNegVal, nPosVal, nCurVal
  372.    store 0 to nI, nNegVal, nPosVal
  373.  
  374.     *-- Pass through array once computing present value of negative
  375.     *-- cashflows at 'safe' rate and present value of positive values
  376.     *-- at the reinvestment rate.
  377.    do while nI < nN
  378.        nI = nI+1
  379.        nCurVal = &cFlow[nI]
  380.        nCurVal = nCurVal*(1+iif(nCurVal<0,nFrate,nRrate))^-(nI-1)
  381.        if nCurVal < 0
  382.            nNegVal = nNegVal + nCurVal
  383.        else
  384.            nPosVal = nPosVal + nCurVal
  385.        endif
  386.    enddo
  387.    if abs(nNegVal) = 0 .or. nPosVal = 0
  388.        wait " There must be at least one negative and one positive value! "
  389.        return 0
  390.    endif
  391.  
  392.     *-- Calculate the rate of return required to yield a future value
  393.     *-- of the positive values reinvested at nRrate from the present
  394.     *-- value of the negative values invested at the 'safe' rate.
  395.  
  396. RETURN ((-nPosVal * (1+nRrate)^(nN-1))/nNegVal)^(1/(nN-1))-1
  397. *-- EoF: Mirr()
  398.  
  399. FUNCTION Xmirr  && {version 1.01}
  400. *-------------------------------------------------------------------------------
  401. *-- Programmer...: Ron Allen (CIS: 71201,2502)
  402. *-- Date.........: 01/27/1993
  403. *-- Notes........: Used to calculate the Modified Internal Rate of Return
  404. *--                from cashflows on random dates. Except for the need to 
  405. *--                supply both the dates of transactions and the cashflows
  406. *--                in an 'nN' by 2 array, the other inputs are the same as 
  407. *--                in Mirr(). Dates may be in random order except for the
  408. *--                first date. The first date in the array establishes 
  409. *--                the date to which present value applies. Enter 'Safe'
  410. *--                rate for reserves and 'Reinvestment' rate for positive 
  411. *--                cashflows as annual rates, e.g., .075 for 7.5%.
  412. *-- Written for..: dBASEIV, version 1.5, tested on build xx71
  413. *-- Rev. History.: 1.01 01/27/93 - to allow entry of 'Safe' reserve rate
  414. *--                  and 'Reinvestment' rate as annual rates rather than 
  415. *--                  rates. Also, to return the 'effective' rate of interest
  416. *--                  when compounded daily, rather than the 'nominal' rate.   
  417. *-- Calls........: None
  418. *-- Called by....: Any
  419. *-- Usage........: Xmirr(<nN>, <cFlow>, <nRrate>, <nFrate>)
  420. *-- Example......: Rate = Xmirr(5, "Cash", .14, .1)
  421. *-- Returns......: Annualized Effective Modified Internal Rate of Return 
  422. *--                based on daily compounded interest.   
  423. *-- Parameters...: nN     = number of cashflows in model
  424. *--                cFlow  = name of 'nN' by 2 array holding the dates (col 1)
  425. *--                          and cashflow amounts (col 2). 
  426. *--                nRrate = Reinvestment rate for positive cashflows. 
  427. *--                nFrate = 'Safe' rate expected on reserve funds to 
  428. *--                          cover disbursements.
  429. *-------------------------------------------------------------------------------
  430.    parameters nN, cFlow, nRrate, nFrate
  431.    private nI, nCurVal, nNegVal, nPosVal, dPDate
  432.    private dMaxDate, dCurDate, nCurN, nMirr
  433.    store 0 to nI, nNegVal, nPosVal
  434.    store (1+nRrate)^(1/365)-1 to nRrate
  435.    store (1+nFrate)^(1/365)-1 to nFrate
  436.    store &cFlow[1,1] to dPDate
  437.    dMaxDate = dPDate
  438.  
  439.    do while nI < nN
  440.        nI = nI+1
  441.        nCurVal = &cFlow[nI,2]
  442.        dCurDate = &cFlow[nI,1]
  443.        dMaxDate = max(dCurDate,dMaxDate)
  444.        nCurN = dCurDate-dPDate
  445.        nCurVal = nCurVal/(1+iif(nCurVal<0,nFrate,nRrate))^nCurN
  446.        if nCurVal < 0
  447.            nNegVal = nNegVal + nCurVal
  448.        else
  449.            nPosVal = nPosVal + nCurVal
  450.        endif
  451.    enddo
  452.    if nNegVal = 0 .or. nPosVal = 0
  453.        wait " There must be at least one negative and one positive value! "
  454.        return 0
  455.    endif
  456.    nN = dMaxDate - dPDate
  457.    nMirr = ((-nPosVal * (1+nRrate)^(nN-1))/nNegVal)^(1/(nN-1))-1
  458.  
  459. RETURN (1+nMirr)^365-1
  460. *-- EoF: Xmirr()
  461.  
  462. FUNCTION Xirr   && {version 1.01}
  463. *-------------------------------------------------------------------------------
  464. *-- Programmer...: Ron Allen (CIS: 71201,2502)
  465. *-- Date.........: 01/25/1993
  466. *-- Notes........: Used to calculate the Internal Rate of Return from
  467. *--                cashflows on random dates. Except for the need to 
  468. *--                supply both the dates of transactions and the cashflows
  469. *--                in an 'nN' by 2 array, the other inputs are the same as 
  470. *--                in Irr(). Dates may be in random order except for the
  471. *--                first date. The first date in the array establishes 
  472. *--                the date to which present value applies.
  473. *-- Written for..: dBASEIV, version 1.5, tested on build xx71
  474. *-- Rev. History.: 1.01 - 01/28/93 - to return 'effective' rate of interest
  475. *--                when compounded daily rather than the 'nominal' rate.
  476. *--                Also to count iterations without a sign change in PV. 
  477. *--                Move division by nRatio outside inner loop.
  478. *-- Calls........: None
  479. *-- Called by....: Any
  480. *-- Usage........: Irr(<nN>, <cFlow>, <lSw>, <nGuess>)
  481. *-- Example......: Rate = Irr(5, "Cash", "Switch", .01)
  482. *-- Returns......: Effective Internal Rate of Return.
  483. *-- Parameters...: nN     = number of cashflows in model
  484. *--                cFlow  = name of the 'nN' by 2 array holding the 
  485. *--                         dates (col 1) and cashflows (col 2). Dates
  486. *--                         may be entered in any order except for the 
  487. *--                         date, which is the date to which present
  488. *--                         value applies.
  489. *--                lSw    = name of a logical variable to be switched to
  490. *--                         indicate valid IRR returned (.t.).
  491. *--                nGuess = optional guess for initializing search.
  492. *-------------------------------------------------------------------------------
  493.    parameters nN, cFlow, lSw, nGuess
  494.    private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, nBigchange
  495.    private nSignChng, nRatio, dPDate, dMaxDate, nCurrPV, nSumDeriv
  496.    private nSumPV, dCurDate, nIters, lSw1
  497.    store 0 to nI, nPosVal, nNegVal, nIters
  498.    Store .t. to lSw
  499.    declare nCashFlow[nN,2]
  500.    store &cFlow[1,1] to dMaxDate, dPDate
  501.    store .f. to lSw1
  502.  
  503.     *-- Transfer cashflows to a private array and separate negatives from
  504.     *-- positives. Find last date. 
  505.    do while nI < nN
  506.        nI = nI+1
  507.        store &cFlow[nI,1] to nCashFlow[nI,1], dCurDate
  508.        store &cFlow[nI,2] to nCashFlow[nI,2], nCurVal
  509.        store max(dCurDate,dMaxDate) to dMaxDate
  510.        if nCurVal < 0
  511.            nNegVal = nNegVal + nCurVal
  512.        else
  513.            nPosVal = nPosVal + nCurVal
  514.        endif
  515.    enddo
  516.    if nNegVal = 0 .or. nPosVal = 0
  517.        wait "Must have at least one positive and one negative value"
  518.    endif
  519.  
  520.     *-- Use initializing guess if provided, otherwise calculate from
  521.     *-- weighted average returns.
  522.    if pcount() = 4
  523.       nIRR = nGuess
  524.    else
  525.         nIRR = (((nPosVal+nNegVal-ncashflow[1,2])/-nCashFlow[1,2])-1)/;
  526.                (dMaxDate-dPDate)
  527.    endif
  528.  
  529.     *-- Housekeeping summary accumulators, etc., before entering loop
  530.    store 1 to nNuDelta, nOlDelta
  531.    store 0 to nSignChng, nBigChange
  532.  
  533.     *-- Loop until estimated rate indicated accuracy
  534.    do while abs(nNuDelta) > .000001
  535.        store 0 to nI, nSumPV, nSumDeriv
  536.        store 1 + nIrr to nRatio
  537.        do while nI < nN
  538.            nI = nI+1
  539.          
  540.             *-- Calculate incremental PV and add to sum
  541.            nCurrPV =  nCashFlow[nI,2] / nRatio^(nCashFlow[nI,1] - dPDate)
  542.            nSumPV = nSumPV + nCurrPV
  543.                 
  544.             *-- Add incremental first derivative to derivative sum
  545.            nSumDeriv = nSumDeriv - (nCashFlow[nI,1] - dPDate) * nCurrPV
  546.        enddo
  547.  
  548.         *-- count iterations and test for sign change of future value
  549.        if .not. lSw1 .and. nIters > 0
  550.            lSw1 = iif(sign(nOldPV) = sign(nSumPV),.f.,.t.)
  551.        endif
  552.        nIters = nIters + 1
  553.        nOldPV = nSumPV
  554.     
  555.         *-- Calculate indicated change in IRR
  556.        nNuDelta = nRatio * nSumPV/nSumDeriv
  557.     
  558.         *-- Test for big changes in adjusted IRR, limit to 10 times
  559.         *-- current guess for IRR and count big changes.
  560.        if abs(nNuDelta/nIRR) > 10
  561.            nNuDelta = sign(nNuDelta) * 10 * nIRR
  562.            nBigChange = nBigChange + 1
  563.        endif
  564.        nIRR = nIRR - nNuDelta   && Make adjustment to guess for IRR
  565.     
  566.         *-- Count reversals in adjustments to limit hunting
  567.        nSignChng = nSignChng + iif(sign(nNuDelta) + sign(nOlDelta) = 0,1,0)
  568.        nOlDelta = nNuDelta
  569.     
  570.         *-- Test for hunting, too many bigchanges or too large a solution
  571.         *-- and set external switch if abnormal exit is used.
  572.        if nSignChng + nBigChange > 10 .or. abs(nIRR) > 100 .or. ;
  573.             (nIters > 9 .and. .not. lSw1)
  574.            store .f. to lSw
  575.            exit
  576.        endif
  577.    enddo
  578.  
  579. RETURN (1+nIrr)^365 -1
  580. *-- EoF: Xirr()
  581.  
  582. FUNCTION FVirr  && {version 1.01}
  583. *-------------------------------------------------------------------------------
  584. *-- Programmer...: Ron Allen (CIS: 71201,2502)
  585. *-- Date.........: 01/28/1993
  586. *-- Notes........: Returns same roots as Irr(), but averages 20% faster. 
  587. *--                Irr() searches for the roots of NPV (Net Present Value),
  588. *--                while FVirr() searches for the same roots of NFV (Net
  589. *--                Future Value), both with respect to the rate of return.
  590. *--                The user may wish to use this UDF in place of Irr() and
  591. *--                use Irr() as an alternate to help locate more multiple
  592. *--                solutions. The reason this UDF is 'usually' faster is due
  593. *--                to the fact that the NFV curve is 'usually' steeper as
  594. *--                it crosses the zero axis.
  595. *-- Written for..: dBASEIV, version 1.5, tested on build xx71
  596. *-- Rev. History.: 1.01  01/28/93 - Modified Irr() to use Net Future Value
  597. *--                curve instead of Net Present Value curve.
  598. *-- Calls........: None
  599. *-- Called by....: Any
  600. *-- Usage........: Irr(<nN>, <cFlow>, <lSw>, <nGuess>)
  601. *-- Example......: Rate = Irr(6, "Cash", Switch, .01)
  602. *-- Returns......: Internal Rate of Return.
  603. *-- Parameters...: nN     = number of cashflows in model
  604. *--                cFlow  = name of the array holding the cashflows
  605. *--                lSw    = name of a logical variable to be switched to
  606. *--                         indicate valid IRR returned (.t.).
  607. *--                nGuess = optional guess for initialing search.
  608. *-------------------------------------------------------------------------------
  609.  
  610.    parameters nN, cFlow, lSw, nGuess
  611.    private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, nBigchange
  612.    private nSignChng, nDiscount, nRatio, nSumFV, nCurrFV, nSumDeriv, nOldFV
  613.    private nIters, lSw1
  614.    store 0 to nI, nPosVal, nNegVal, nIters
  615.    store .t. to lSw
  616.    store .f. to lSw1
  617.    declare nCashFlow[nN]
  618.  
  619.     *-- Transfer cashflows to a private array and separate negatives from
  620.     *-- positives
  621.    do while nI < nN
  622.        nI = nI+1
  623.        store &cFlow[nI] to nCashFlow[nI], nCurVal
  624.        if nCurVal < 0
  625.            nNegVal = nNegVal + nCurVal
  626.        else
  627.            nPosVal = nPosVal + nCurVal
  628.        endif
  629.    enddo
  630.    if nNegVal = 0 .or. nPosVal = 0
  631.        wait "Must have at least one positive and one negative value"
  632.    endif
  633.  
  634.     *-- Use initializing guess if provided, otherwise calculate from
  635.     *-- weighted average returns.
  636.    if pcount() = 4
  637.       nIRR = nGuess
  638.    else
  639.        nIRR = ((-nPosVal/nNegVal)-1)/nN
  640.    endif
  641.     
  642.     *-- Housekeeping summary accumulators, etc., before entering loop
  643.    store 1 to nNuDelta, nOlDelta
  644.    store 0 to nSignChng, nBigChange
  645.  
  646.     *-- Loop until estimated rate indicated accuracy
  647.    do while abs(nNuDelta) > .000001
  648.        store 0 to nI, nSumFV, nSumDeriv
  649.     
  650.         *-- Set up cumulative denominator to calculate incremental NFV   
  651.        nRatio = 1 + nIRR
  652.        nDiscount = nRatio^nN
  653.        do while nI < nN
  654.            nI = nI+1
  655.            nDiscount = nDiscount/nRatio
  656.                 
  657.             *-- Calculate incremental FV and add to sum
  658.            nCurrFV = nDiscount * nCashFlow[nI]
  659.            nSumFV = nSumFV + nCurrFV
  660.         
  661.             *-- Add incremental first derivative to derivative sum
  662.            nSumDeriv = nSumDeriv - nI * nCurrFV
  663.        enddo
  664.     
  665.         *-- count iterations and test for sign change of future value
  666.        if .not. lSw1 .and. nIters > 0
  667.            lSw1 = iif(sign(nOldFV) = sign(nSumFV),.f.,.t.)
  668.        endif
  669.        nIters = nIters + 1
  670.        nOldFV = nSumFV
  671.  
  672.         *-- Calculate indicated change in IRR
  673.        nNuDelta = nRatio * nSumFV/nSumDeriv
  674.     
  675.         *-- Test for big changes in adjusted IRR, limit to 10 times
  676.         *-- current guess for IRR and count big changes.
  677.        if abs(nNuDelta/nIRR) > 10
  678.            nNuDelta = sign(nNuDelta) * 10 * nIRR
  679.            nBigChange = nBigChange + 1
  680.        endif
  681.        nIRR = nIRR - nNuDelta   && Make adjustment to guess for IRR
  682.     
  683.         *-- Count reversals in adjustments to limit hunting
  684.        nSignChng = nSignChng + iif(sign(nNuDelta) + sign(nOlDelta) = 0,1,0)
  685.        nOlDelta = nNuDelta
  686.             
  687.         *-- Test for hunting, too many bigchanges or too large a solution
  688.         *-- and set external switch if abnormal exit is used.
  689.        if nSignChng + nBigChange > 10 .or. abs(nIRR) > 100 .or. ;
  690.              (nIters > 9 .and. .not. lSw1)
  691.            store .f. to lSw
  692.            exit
  693.        endif
  694.    enddo
  695.  
  696. RETURN nIRR
  697. *-- EoF: FVirr()
  698.  
  699. FUNCTION FVxirr  && {version 1.01}
  700. *-------------------------------------------------------------------------------
  701. *-- Programmer...: Ron Allen (CIS: 71201,2502)
  702. *-- Date.........: 01/28/1993
  703. *-- Notes........: Same as Xirr() except that the Net Future Value (NFV)
  704. *--                function is used instead of the Net Present Value (NPV)
  705. *--                function. The roots are the same, but this function is
  706. *--                usually faster for the same reasons that FVirr() is
  707. *--                faster than Irr(). As in Xirr(), all dates except the 
  708. *--                first date in the array may be in random order. The first 
  709. *--                date in the nN by 2 array along with the maximum date
  710. *--                establishes the range of the investment analysis. 
  711. *-- Written for..: dBASEIV, version 1.5, tested on build xx71
  712. *-- Rev. History.: 1.01 - 01/28/93 - Modified Xirr() to find roots of the
  713. *--                 Net Future Value curve.
  714. *-- Calls........: None
  715. *-- Called by....: Any
  716. *-- Usage........: Irr(<nN>, <cFlow>, <lSw>, <nGuess>)
  717. *-- Example......: Rate = Irr(5, "Cash", Switch, .01)
  718. *-- Returns......: Effective Internal Rate of Return.
  719. *-- Parameters...: nN     = number of cashflows in model
  720. *--                cFlow  = name of the 'nN' by 2 array holding the 
  721. *--                         dates (col 1) and cashflows (col 2). Dates
  722. *--                         may be entered in any order except for the 
  723. *--                         date, which is the date to which present
  724. *--                         value applies.
  725. *--                lSw    = name of a logical variable to be switched to
  726. *--                         indicate valid IRR returned (.t.).
  727. *--                nGuess = optional guess for initializing search.
  728. *-------------------------------------------------------------------------------
  729.    parameters nN, cFlow, lSw, nGuess
  730.    private nI, nPosVal, nNegVal, nCurVal, nIRR, nNuDelta, nOlDelta, nBigchange
  731.    private nSignChng, nRatio, dPDate, dMaxDate, nCurrFV, nSumDeriv
  732.    private nSumFV, dCurDate, lSw1, nIters
  733.    store 0 to nI, nPosVal, nNegVal, nIters
  734.    Store .t. to lSw
  735.    declare nCashFlow[nN,2]
  736.    store &cFlow[1,1] to dMaxDate, dPDate
  737.  
  738.     *-- Transfer cashflows to a private array and separate negatives from
  739.     *-- positives. Find last date. 
  740.     
  741.    do while nI < nN
  742.        nI = nI+1
  743.        store &cFlow[nI,1] to nCashFlow[nI,1], dCurDate
  744.        store &cFlow[nI,2] to nCashFlow[nI,2], nCurVal
  745.        store max(dCurDate,dMaxDate) to dMaxDate
  746.        if nCurVal < 0
  747.            nNegVal = nNegVal + nCurVal
  748.        else
  749.            nPosVal = nPosVal + nCurVal
  750.        endif
  751.    enddo
  752.    if nNegVal = 0 .or. nPosVal = 0
  753.        wait "Must have at least one positive and one negative value"
  754.    endif
  755.  
  756.     *-- Use initializing guess if provided, otherwise calculate from
  757.     *-- weighted average returns.
  758.    if pcount() = 4
  759.       nIRR = nGuess
  760.    else
  761.        nIRR = (((nPosVal+nNegVal-ncashflow[1,2])/-nCashFlow[1,2])-1)/;
  762.                 (dMaxDate-dPDate)
  763.    endif
  764.  
  765.     *-- Housekeeping summary accumulators, etc., before entering loop
  766.    store 1 to nNuDelta, nOlDelta
  767.    store 0 to nSignChng, nBigChange
  768.    store .f. to lSw1
  769.  
  770.     *-- Loop until estimated rate indicated accuracy
  771.    do while abs(nNuDelta) > .000001
  772.        store 0 to nI, nSumFV, nSumDeriv
  773.        store 1 + nIrr to nRatio
  774.        do while nI < nN
  775.            nI = nI+1
  776.         
  777.             *-- Calculate incremental FV and add to sum
  778.            nCurrFV =  nCashFlow[nI,2] * nRatio^(dMaxDate - nCashFlow[nI,1])
  779.            nSumFV = nSumFV + nCurrFV
  780.                 
  781.             *-- Add incremental first derivative to derivative sum
  782.            nSumDeriv = nSumDeriv + (dMaxDate - nCashFlow[nI,1]) * nCurrFV
  783.        enddo
  784.     
  785.         *-- count iterations and test for sign change of future value
  786.        if .not. lSw1 .and. nIters > 0
  787.            lSw1 = iif(sign(nOldFV) = sign(nSumFV),.f.,.t.)
  788.        endif
  789.        nIters = nIters + 1
  790.        nOldFV = nSumFV
  791.  
  792.         *-- Calculate indicated change in IRR
  793.        nNuDelta = nRatio * nSumFV/nSumDeriv
  794.  
  795.         *-- Test for big changes in adjusted IRR, limit to 10 times
  796.         *-- current guess for IRR and count big changes.
  797.        if abs(nNuDelta/nIRR) > 10
  798.            nNuDelta = sign(nNuDelta) * 10 * nIRR
  799.            nBigChange = nBigChange + 1
  800.        endif
  801.        nIRR = nIRR - nNuDelta   && Make adjustment to guess for IRR
  802.     
  803.         *-- Count reversals in adjustments to limit hunting
  804.        nSignChng = nSignChng + iif(sign(nNuDelta) + sign(nOlDelta) = 0,1,0)
  805.        nOlDelta = nNuDelta
  806.  
  807.         *-- Test for hunting, too many bigchanges or too large a solution
  808.         *-- and set external switch if abnormal exit is used.
  809.         if nSignChng + nBigChange > 10 .or. abs(nIRR) > 100 .or. ;
  810.               (nIters > 9 .and. .not. lSw1)
  811.            store .f. to lSw
  812.            exit
  813.        endif
  814.    enddo
  815.  
  816. RETURN (1+nIrr)^365 -1
  817. *-- EoF: FVxirr()
  818.  
  819. *-------------------------------------------------------------------------------
  820. *-- Note: The following functions are here as a courtesy, as they are used in at
  821. *-- least one of the functions above.
  822. *-------------------------------------------------------------------------------
  823.  
  824. FUNCTION Zeroin
  825. *-------------------------------------------------------------------------------
  826. *-- Programmer..: Tony Lima (CIS: 72331,3724) and Jay Parsons (CIS: 70160,340)
  827. *-- Date........: 4/13/1992
  828. *-- Notes.......: Finds a zero of a continuous function.
  829. *--             : In substance, what this function does is close in on a
  830. *--             : solution to a function that cannot otherwise be solved.
  831. *--             : Assuming Y = f(X), if Y1 and Y2, the values of the function
  832. *--             : for X1 and X2, have different signs, there must be at least
  833. *--             : one value of X between X1 and X2 for which Y = 0, if the
  834. *--             : function is continuous.  This function closes in on such a
  835. *--             : value of X by a trial-and-error process.
  836. *--             :
  837. *--             : This function is very slow, so a maximum number of iterations
  838. *--             : is passed as a parameter.  If the number of iterations is
  839. *--             : exceeded, the function will fail to find a root.  If this
  840. *--             : occurs, pick different original "X" values, increase the
  841. *--             : number of iterations or increase the errors allowed.  Once
  842. *--             : an approximate root is found, you can use values of X close
  843. *--             : on either side and reduce the error allowed to find an
  844. *--             : improved solution.  Also, of course, the signs of Y must be
  845. *--             : different for the starting X values for the function to
  846. *--             : proceed at all.
  847. *--             :
  848. *--             : NOTE ESPECIALLY - There is NO guarantee that a root returned
  849. *--             : by this function is the only one, or the most meaningful.
  850. *--             : It depends on the function that this function calls, but if
  851. *--             : that function has several roots, any of them may be returned.
  852. *--             : This can easily happen with such called functions as net
  853. *--             : present value where the cash flows alternate from positive
  854. *--             : to negative and back, and in many other "real life" cases.
  855. *--             : See the discussion of @IRR in the documentation of a good
  856. *--             : spreadsheet program such as Quattro Pro for further
  857. *--             : information.
  858. *--             :
  859. *--             : The method used by this function is a "secant and bisect"
  860. *--             : search.  The "secant" is the line connecting two X,Y
  861. *--             : points on a graph using standard Cartesian coordinates.
  862. *--             : Where the secant crosses the X axis is the best guess for
  863. *--             : the value of X that will have Y = 0, and will be correct
  864. *--             : if the function is linear between the two points.  The
  865. *--             : basic strategy is to calculate Y at that value of X, then
  866. *--             : keep the new X and that one of the old X values that had
  867. *--             : a Y-value of opposite sign, and reiterate to close in.
  868. *--             :
  869. *--             : If the function is a simple curve with most of the change
  870. *--             : in Y close to one of the X-values, as often occurs if the
  871. *--             : initial values of X are poorly chosen, repeated secants
  872. *--             : will do little to find a Y-value close to zero and will
  873. *--             : reduce the difference in X-values only slightly.  In this
  874. *--             : case the function shifts to choosing the new X halfway
  875. *--             : between the old ones, bisecting the difference and always
  876. *--             : reducing the bracket by half, for a while.
  877. *--             :
  878. *--             : While this function finds a "zero", it may be used to
  879. *--             : find an X corresponding to any other value of Y.  Suppose
  880. *--             : the function of X is FUNCTION Blackbox( X ) and it is
  881. *--             : desired to find a value of X for which f(X) = 7.  The trick
  882. *--             : is to interpose a function between Zeroin() and Blackbox()
  883. *--             : that will return a 0 to Zeroin() whenever Blackbox() returns
  884. *--             : 7.  By calling that function, Zeroin() finds a value of
  885. *--             : X for which Blackbox( X ) = 7, as required:
  886. *--             :    Result = Zeroin( "Temp", <other parameters omitted> )
  887. *--             :
  888. *--             :    FUNCTION Temp
  889. *--             :    parameters nQ
  890. *--             :    RETURN Blackbox( nQ ) - 7
  891. *--             :
  892. *-- Written for.: dBASE IV Version 1.5
  893. *-- Rev. History: Original function 1990.
  894. *--             : Modified to take optional parameters, 4/13/1992
  895. *-- Calls       : The function whose name is first parameter.
  896. *--             : NPV()             Function in FINANCE.PRG
  897. *-- Called by...: Any
  898. *-- Usage.......: Zeroin( <cFunction>, <fX1>, <fX2>, <fAbserror>, ;
  899. *--             :  <nMaxiter>, <n_Flag> ;
  900. *--             :  [, xPass1 [, xPass2 [, xPass3 ] ] ] )
  901. *-- Example.....: ? Zeroin( "Npv", 0, 200, .000001, 200, n_Flag, 11 )
  902. *-- Returns     : a float value representing a root, if n_Flag < 3.
  903. *-- Parameters..: cFunction, the name of the function to solve for a root.
  904. *--               fX1, one of the X-values between which the root is sought.
  905. *--               fX2, the second of these values.
  906. *--               Note: These MUST be chosen so the f( X ) values for the two
  907. *--               of them have opposite signs (they must bracket the result).
  908. *--               fAbserror, the absolute error allowed in the result.
  909. *--               nMaxiter, the maximum number of times to iterate.
  910. *--               n_Flag, an integer to signal success ( < 3 ) or failure.
  911. *--               xPass1 . . . 3, arguments to be passed through to cFunction.
  912. *--               The parameter "n_Flag" should be passed as a variable so it
  913. *--               may be accessed on return.  The limit of 9 literal parameters
  914. *--               may require passing others as variables.  The "xPass"
  915. *--               parameters are optional and the fact there are three of them
  916. *--               is arbitrary; they exist to hold whatever parameters may be
  917. *--               needed by the function cFunction being called aside from
  918. *--               the value of X for which it is being evaluated.  Add more
  919. *--               and change the 3 "&cFunc." lines below if you need more.
  920. *-- Side effects: Uses and alters a global numeric variable, here called
  921. *--               "n_Flag", to report error conditions resulting in value
  922. *--               returned being meaningless.  Possible n_Flag values are:
  923. *--                     1       success - root found within error allowed
  924. *--                     2       success - root was found exactly
  925. *--                     3       error   - function value not converging
  926. *--                     4       error   - original values do not bracket a root
  927. *--                     5       error   - maximum iterations exceeded
  928. *-------------------------------------------------------------------------------
  929.    parameters cFunc, fNearx, fFarx, fAbserr, nMaxiter, ;
  930.               n_Flag, xPass1, xPass2, xPass3
  931.    private nSplits, fBracket, fFary, fNeary, nIters
  932.    private fMaxabs, fOldx, fOldy, fDiffx, fAbsdiff, fSecant
  933.  
  934.    store 0 to nSplits, nIters
  935.    fBracket = abs ( fNearx - fFarx )
  936.    fFary = &cFunc.( fFarx, xPass1, xPass2, xPass3 )
  937.    fNeary = &cFunc.( fNearx, xPass1, xPass2, xPass3 )
  938.  
  939.    if sign( fNeary ) = sign( fFary )
  940.       n_Flag = 4
  941.       return float(0)
  942.    endif
  943.  
  944.    fMaxabs = max( abs( fNeary ), abs( fFary ) )
  945.    n_Flag = 0
  946.  
  947.    * Main iteration loop
  948.  
  949.    do while .t.
  950.  
  951.       if abs( fFary ) < abs( fNeary )
  952.  
  953.          * Interchange fNearx and fFarx so that
  954.          * fNearx is closer to a solution--
  955.          * abs( fNeary ) <= abs( fFary )
  956.  
  957.          fOldx  = fNearx
  958.          fOldy  = fNeary
  959.          fNearx = fFarx
  960.          fNeary = fFary
  961.          fFarx  = fOldx
  962.          fFary  = fOldy
  963.       endif
  964.  
  965.       fDiffx = fFarx - fNearx
  966.       fAbsdiff = abs( fDiffx )
  967.  
  968.       * Test whether interval is too small to continue
  969.  
  970.       if fAbsdiff <= 2 * fAbserr
  971.          if abs( fNeary ) > fMaxabs
  972.  
  973.             * Yes, but we are out of bounds
  974.  
  975.             n_Flag = 3
  976.             fNearx = float(0)
  977.          else
  978.  
  979.             * Yes, and we have a solution!
  980.  
  981.             n_Flag = 1
  982.          endif
  983.          exit
  984.       endif
  985.  
  986.       * Save the last approximation to x and y
  987.  
  988.       fOldx = fNearx
  989.       fOldy = fNeary
  990.  
  991.       * Check if reduction in the size of
  992.       * bracketing interval is satisfactory.
  993.       * If not, bisect until it is.
  994.  
  995.       nSplits = nSplits + 1
  996.       if nSplits >= 4
  997.          if 4 * fAbsdiff >= fBracket
  998.             fNearx = fNearx + fDiffx / 2
  999.          else
  1000.             nSplits = 0
  1001.             fBracket = fAbsdiff / 2
  1002.  
  1003.             * Calculate secant
  1004.  
  1005.             fSecant = ( fNearx - fFarx ) * fNeary ;
  1006.                                / ( fFary - fNeary )
  1007.  
  1008.             * But not less than error allowed
  1009.  
  1010.             if abs( fSecant ) < fAbserr
  1011.                fNearx = fnearx + fAbserr * sign( fDiffx )
  1012.             else
  1013.                fNearx = fNearx + fSecant
  1014.             endif
  1015.          endif
  1016.       endif
  1017.  
  1018.       * Evaluate the function at the new approximation
  1019.  
  1020.       fNeary = &cFunc.( fNearx, xPass1, xPass2, xPass3 )
  1021.  
  1022.       * If it's exactly zero, we win!  Run with it
  1023.  
  1024.       if fNeary = 0.00
  1025.          n_Flag = 2
  1026.          exit
  1027.       endif
  1028.  
  1029.       * Else adjust iteration count and quit if too
  1030.       * many iterations with no solution
  1031.  
  1032.       nIters = nIters + 1
  1033.       if nIters > nMaxiter
  1034.          n_Flag = 5
  1035.          fNearx = float( 0 )
  1036.          exit
  1037.       endif
  1038.  
  1039.       * And finally keep as the new fFarx that one
  1040.       * of the previous approximations, fFarx and
  1041.       * fOldx, at which the function has a sign opposite
  1042.       * to that at the new approximation, fNearx.
  1043.  
  1044.       if sign( fNeary ) = sign( fFary )
  1045.          fFarx = fOldx
  1046.          fFary = fOldy
  1047.       endif
  1048.    enddo
  1049.  
  1050. RETURN fNearx
  1051. *-- EoF: Zeroin()
  1052.  
  1053. FUNCTION ArrayRows
  1054. *-------------------------------------------------------------------------------
  1055. *-- Programmer..: Jay Parsons (CIS: 70160,340)
  1056. *-- Date........: 03/01/1992
  1057. *-- Notes.......: Number of Rows in an array
  1058. *-- Written for.: dBASE IV, 1.1
  1059. *-- Rev. History: None
  1060. *-- Calls.......: None
  1061. *-- Called by...: Any
  1062. *-- Usage.......: ArrayRows("<aArray>")
  1063. *-- Example.....: n = ArrayRows("aTest")
  1064. *-- Returns.....: numeric
  1065. *-- Parameters..: aArray      = Name of array 
  1066. *-------------------------------------------------------------------------------
  1067.  
  1068.     parameters aArray
  1069.     private nHi, nLo, nTrial, nDims
  1070.     nLo = 1
  1071.     nHi = 1170
  1072.     if type( "&aArray[ 1, 1 ]" ) = "U"
  1073.       nDims = 1
  1074.     else
  1075.      nDims = 2
  1076.     endif
  1077.     do while .T.
  1078.      nTrial = int( ( nHi + nLo ) / 2 )
  1079.       if nHi < nLo
  1080.         exit
  1081.       endif
  1082.      if nDims = 1 .and. type( "&aArray[ nTrial ]" ) = "U" .or. ;
  1083.        nDims = 2 .and. type( "&aArray[ nTrial, 1 ]" ) = "U"
  1084.         nHi = nTrial - 1
  1085.       else
  1086.         nLo = nTrial + 1
  1087.       endif
  1088.     enddo
  1089.     
  1090. RETURN nTrial
  1091. *-- EoF: ArrayRows()
  1092.  
  1093. *-------------------------------------------------------------------------------
  1094. *-- EoP: FINANCE.PRG
  1095. *-------------------------------------------------------------------------------
  1096.